home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / amigae / fdtom_13.lha / FDtoM.e < prev    next >
Encoding:
Text File  |  1994-10-03  |  12.1 KB  |  559 lines
  1.  
  2. /* FDtoM
  3.  *
  4.  * This nice utility converts a '.fd' file into an E binary module.
  5.  * it understands :
  6. ---------
  7.  * remark
  8.  ##base _xyzBase
  9.  ##bias wert
  10.  ##public
  11.  ##private
  12.  Function(arg1,arg2,...,regx)(reg1,reg2,..,regx)
  13.  Function(arg1,arg2,...,regx)(reg1/reg2/../regx)
  14.  ##end
  15. ---------
  16.  *
  17.  * Written by Detlef Riekenberg
  18.  *
  19.  * 1.3 (3.10.94)
  20.  *     Some Code-Cleanup : Much faster by using dos/FGets() [v36+]
  21.  *     Added ASM-Switch and 3.Output-File: libname_lvo.i
  22.  *
  23.  * 1.2 (23.7.94)
  24.  *     Added DEVICE & RESOURCE-Switch
  25.  *     (Minimum Library-Offset in AmigaE is 30, but the LVO-File is ok)
  26.  *
  27.  * 1.1 (6.2.94)
  28.  *     Added "/" as Register-Seperator
  29.  *     Added FDtom.doc
  30.  *
  31.  * 1.0 (29.6.93)
  32.  *     Initial Release
  33.  *
  34.  * USAGE: FDtoM <.fdfile> <.fdfile2> <.fdfilex>
  35.  *
  36.  */
  37.  
  38.  
  39.  MODULE    'dos/dos'                    /* ERROR_* - Code's*/
  40.  
  41.  
  42. /* Type's in the *.m - File: */
  43. ENUM T_DONE,T_CONST,T_OBJ,T_LIBRARY=6
  44.  
  45.  
  46. /* Some Error-Code's */
  47. ENUM ER_NONE,ER_ARGS,
  48.     ER_FD,ER_TMP,ER_LVO,ER_OUT,                /* File's */
  49.     ER_MEM,ER_BREAK,ER_FORM,
  50.     ER_CMD,ER_NAME,ER_BIAS,ER_BASE
  51.  
  52.  
  53. /* String's */
  54.  
  55. DEF    fdname[256]:STRING,     /* File to Convert */
  56.     outname[80]:STRING,     /* Library-File.m */
  57.     tmpname[80]:STRING,     /* CONST-File.m (LVOUNCTIONNAME=)*/
  58.     lvoname[80]:STRING,     /* ASM-File.lvo (_LVOFunction EQU)*/
  59.  
  60.     fdline[256]:STRING,        /* Input_Line */
  61.     outline[256]:STRING,     /* Lib-Line */
  62.     tmpline[256]:STRING,     /* CONST-Line */
  63.     basename[64]:STRING,    /* > xyzBase */
  64.     libraryname[64]:STRING, /* > xyz.library */
  65.  
  66.     fdhandle=    NIL,
  67.     outhandle=    NIL,
  68.     lvohandle=    NIL,
  69.     tmphandle=    NIL,
  70.  
  71.     noeof    =    TRUE,
  72.  
  73.     resource,                /* Special handling for resource-file's */
  74.     device,                    /* Special handling for device-file's */
  75.     asmflag,                /* libname_lvo.x - Output, when asmflag <> 0 */
  76.     linelen,
  77.     fpart
  78.  
  79.  
  80. DEF    names,thisname,
  81.     line=0,
  82.     dosnum=0,
  83.     a,l
  84.  
  85.  
  86. DEF    myargs:PTR TO LONG,
  87.     rdargs
  88.  
  89. /*#################################################*/
  90. /* Sub-Code's */
  91.  
  92. PROC outword(dummy)
  93.   IF (Write(outhandle,dummy+2,2))<>2 THEN error(ER_OUT)
  94. ENDPROC
  95.  
  96. PROC outlong(dummy)
  97.   IF (Write(outhandle,dummy,4))<>4 THEN error(ER_OUT)
  98. ENDPROC
  99.  
  100. PROC tmpword(dummy)
  101.   IF (Write(tmphandle,dummy+2,2))<>2 THEN error(ER_TMP)
  102. ENDPROC
  103.  
  104. PROC tmplong(dummy)
  105.   IF (Write(tmphandle,dummy,4))<>4 THEN error(ER_TMP)
  106. ENDPROC
  107.  
  108. /* ######################### */
  109. /* Changed in V1.3 for Speed */
  110.  
  111. PROC getline()
  112.   IF (KickVersion(36))
  113.       noeof:=(Fgets(fdhandle,fdline,254))
  114.   ELSE
  115.       noeof:=(ReadStr(fdhandle,fdline)<>-1)
  116.   ENDIF
  117.  
  118.   MOVE.L    fdline,A0            /* Get Line-Start */
  119.   MOVEQ        #0,D1
  120.   NOT.B        D1                    /* Max-len = 255 */
  121. getline_find0:
  122.   TST.B    (A0)+
  123.   DBEQ.S    D1,getline_find0
  124.   CLR.B        -2(A0)                /* Remove Linefeed */
  125.  
  126.   ADDQ.L    #1,line
  127.   IF  (dosnum:=IoErr())>0 THEN error(ER_FD)
  128. ENDPROC
  129.  
  130.  
  131. /*#################################################*/
  132. /* Version-String */
  133.  
  134. version_txt:
  135. CHAR    0,'$VER: FDtoM 1.3 (3.10.94) by Detlef Riekenberg',0
  136.  
  137. /*#################################################*/
  138.  
  139. PROC main()
  140.   myargs:=[0,0,0,0,0,0]
  141.  
  142.   IF wbmessage<>0 THEN error(ER_ARGS)
  143.  
  144.   WriteF('\n\e[1m\s.\e[0m\n',{version_txt}+7)
  145.  
  146. /* Use DOS to Support Multiple Filename's */
  147.   IF (KickVersion(36))
  148.     IF (rdargs:=ReadArgs('FILE/A/M,RESOURCE/S,DEVICE/S,ASM/S',myargs,NIL))=0 THEN error(ER_ARGS)
  149.   ELSE
  150.     /* Remove SPACE & TAB */
  151.     MOVE.L    arg,A0
  152.     MOVEQ    #32,D1
  153.     MOVEQ    #9,D2
  154.  
  155. parse_old_loop:
  156.     MOVE.B    (A0)+,D0
  157.     BEQ.S    parse_old_end
  158.     CMP.B    D0,D1
  159.     BEQ.S    parse_old_loop
  160.     CMP.B    D0,D2
  161.     BEQ.S    parse_old_loop
  162. parse_old_end:
  163.     SUBQ.L    #1,A0
  164.     MOVE.L    A0,a
  165.     MOVE.L    A0,D2
  166.  
  167.     MOVE.L    myargs,A1                    /* Create Fake File/A/M-Arg */
  168.     LEA        16(A1),A2
  169.     MOVE.L    A2,(A1)+
  170.     CLR.L    (A1)+
  171.     MOVE.L    A0,(A1)+
  172.     CLR.L    (A1)+
  173.     CLR.L    rdargs
  174.   ENDIF
  175.  
  176.   resource:=myargs[1]
  177.   device:=myargs[2]
  178.   asmflag:=myargs[3]
  179.  
  180.   IF (names:=myargs[0])=0 THEN error(ER_ARGS)
  181.   StrCopy(fdname,Long(names),ALL)
  182.   IF (StrCmp(fdname,'?',ALL)) OR ((StrLen(fdname))=0) THEN error(ER_ARGS)
  183.  
  184. /*---------------------*/
  185. /* Loop for every Name */
  186. /*---------------------*/
  187.  
  188.   WHILE (thisname:=Long(names))
  189.  
  190.     libraryname[]:=0
  191.     basename[]:=0
  192.     CLR.L    line
  193.  
  194.     StrCopy(fdname,thisname,ALL)
  195.  
  196.  
  197. /*---------------------------*/
  198. /* fpart:=FilePart(FileName) */
  199. /*---------------------------*/
  200.  
  201.  
  202.     MOVE.L    thisname,A0
  203.     MOVEQ    #":",D0
  204.     MOVEQ    #":",D1
  205.     MOVEQ    #"/",D2
  206. partloop:
  207.     CMP.B    D0,D1                /* Remove Drive: */
  208.     BEQ.S    partloop1
  209.     CMP.B    D0,D2                /* Remove Directory/ */
  210.     BNE.S    partloop2
  211. partloop1:
  212.     MOVE.L    A0,A1                /* A1=Filename-Start-Address */
  213. partloop2:
  214.     MOVE.B    (A0)+,D0            /* Get Next Char. End of Filename ? */
  215.     BNE.S    partloop
  216.     MOVE.L    A1,fpart
  217.  
  218.     l:=StrLen(fpart)
  219.     a:=EstrLen(fdname)
  220.  
  221. /*---------------------*/
  222. /* Test File-extension */
  223. /*---------------------*/
  224.     linelen:=7
  225.     IF    linelen>l THEN linelen:=l
  226.  
  227.     RightStr(tmpline,fdname,linelen)                /* "_LIB.FD" = 7 Char */
  228.     UpperStr(tmpline)
  229.     IF    linelen>2
  230.         IF (StrCmp(tmpline+linelen-3,'.FD',3))
  231.             SUBQ.L    #3,l                            /* String-Len without ".fd" */
  232.             SUBQ.L    #3,linelen
  233.             SUBQ.L    #3,a
  234.         ENDIF
  235.     ENDIF
  236.  
  237.     IF    linelen>3
  238.         IF (StrCmp(tmpline+linelen-4,'_LIB',4))
  239.             SUBQ.L    #4,l                            /* Len without "_lib.fd" */
  240.         ENDIF
  241.     ENDIF
  242.  
  243.  
  244. /*----------------*/
  245. /* Open .fd-File  */
  246. /*----------------*/
  247.     SetStr(fdname,a)
  248.  
  249.     IF (fdhandle:=Open(fdname,OLDFILE))=NIL
  250.  
  251.         IF ( (dosnum:=IoErr() )<>ERROR_OBJECT_NOT_FOUND) THEN error(ER_FD)
  252.  
  253.         StrAdd(fdname,'.fd',ALL)                    /* Try with extension */
  254.         IF (fdhandle:=Open(fdname,OLDFILE))=NIL
  255.             SetStr(fdname,a)
  256.             StrAdd(fdname,'_lib.fd',ALL)            /* Try with extension */
  257.             IF (fdhandle:=Open(fdname,OLDFILE))=NIL THEN error(ER_FD)
  258.         ENDIF
  259.     ENDIF
  260.  
  261. /*--------------------*/
  262. /* Make New Filenames */
  263. /*--------------------*/
  264.     StrCopy(tmpname,fpart,l)
  265.     StrAdd(tmpname,'_lvo.m',ALL)
  266.  
  267.     StrCopy(lvoname,fpart,l)
  268.     StrAdd(lvoname,'_lvo.i',ALL)
  269.  
  270.     StrCopy(outname,fpart,l)
  271.     StrAdd(outname,'.m',ALL)
  272.  
  273. /*--------------*/
  274. /* File valid ? */
  275. /*--------------*/
  276.  
  277.      IF (linelen:=FileLength(fdname))<=0 THEN error(ER_FD)
  278.     WriteF('Now trying to convert <\s>.\n\e[0 p',fdname)
  279.  
  280.     IF (outhandle:=Open(outname,NEWFILE))=NIL THEN error(ER_OUT)
  281.     IF (tmphandle:=Open(tmpname,NEWFILE))=NIL THEN error(ER_TMP)
  282.     IF    asmflag
  283.         IF (lvohandle:=Open(lvoname,NEWFILE))=NIL THEN error(ER_LVO)
  284.  
  285.         StrCopy(tmpline,fpart,l)
  286.         UpperStr(tmpline)
  287.         StringF(outline,'\n;* Generated by \s *\n\n\tIFND \s_LVO_I\n\s_LVO_I\tSET 1\n\n',{version_txt}+7,tmpline,tmpline)
  288.         a:=EstrLen(outline)
  289.         IF (Write(lvohandle,outline,a))<a THEN error(ER_LVO)
  290.  
  291.     ENDIF
  292.  
  293. /*-------------*/
  294. /* File Ident. */
  295. /*-------------*/
  296.  
  297.     outlong('EMOD')
  298.     outword([T_LIBRARY])
  299.  
  300.     tmplong('EMOD')
  301.     tmpword([T_CONST])
  302.  
  303.     makemodule()
  304.  
  305. /*---------*/
  306. /* CleanUp */
  307. /*---------*/
  308.  
  309.     IF fdhandle
  310.         Close(fdhandle)
  311.         CLR.L    fdhandle
  312.     ENDIF
  313.     IF tmphandle
  314.         Close(tmphandle)
  315.         CLR.L    tmphandle
  316.     ENDIF
  317.     IF lvohandle
  318.         Close(lvohandle)
  319.         CLR.L    lvohandle
  320.     ENDIF
  321.     IF outhandle
  322.         Close(outhandle)
  323.         CLR.L    outhandle
  324.     ENDIF
  325.     ADDQ.L    #4,names            /* PTR to the next Name or 0 */
  326.   ENDWHILE
  327.   error(ER_NONE)
  328. ENDPROC
  329.  
  330.  
  331. /* ####################### */
  332. /* The Converting Funktion */
  333. /* ####################### */
  334.  
  335. PROC makemodule()
  336. DEF    fdtmp[256]:STRING,            /* Line to Ucase(varname) */
  337.     bias=30,                    /* Default's */
  338.     newbias,
  339.     pos:PTR TO CHAR,
  340.     pos2,
  341.     c
  342.  
  343. /* Added in V1.2 for correct Bias*/
  344.   IF resource THEN bias:=6
  345.  
  346.   WriteF('\n\e[ALine:      :')        /* Changed in V1.3 for Speed */
  347.  
  348.   getline()
  349.   WHILE    (noeof)
  350.     IF CtrlC() THEN error(ER_BREAK)
  351.     WriteF('\e[4D\d[4]',line)        /* Changed in V1.3 for Speed */
  352.     StrCopy(fdtmp,fdline,ALL)
  353.  
  354.     UpperStr(fdtmp)
  355.     c:=fdtmp[0]
  356.     IF (c="#")
  357.         IF fdtmp[1]<>"#" THEN error(ER_FORM)
  358.         IF    (StrCmp(fdtmp+2,'BASE',4))
  359.             IF basename[] THEN error(ER_BASE)
  360.             MOVE.L    fdtmp,A0
  361.             MOVEQ    #" ",D0
  362.             MOVEQ    #5,D1
  363. clrloop1:
  364.             MOVE.B    D0,(A0)+
  365.             DBRA    D1,clrloop1
  366.             pos:=TrimStr(fdtmp)
  367.             IF (StrCmp(pos,'_',1)) THEN ADDQ.L    #1,pos
  368.  
  369.             StrCopy(basename,pos,ALL)
  370.             LowerStr(basename)
  371.             l:=EstrLen(basename)
  372.             StrCopy(libraryname,basename,l-4)
  373.  
  374. /* changed in V1.2 for correct Name in the Header.*/
  375.  
  376.             IF    resource
  377.                 StrAdd(libraryname,'.resource',ALL)
  378.                 ADDQ.L    #1,l
  379.             ELSEIF    device
  380.                 StrAdd(libraryname,'.device',ALL)
  381.                 SUBQ.L    #1,l
  382.             ELSE
  383.                 StrAdd(libraryname,'.library',ALL)
  384.             ENDIF
  385.  
  386. /* End of V1.2-change */
  387.  
  388.             StrCopy(outline,libraryname,ALL)
  389.             StrAdd(outline,' ',1)
  390.             StrAdd(outline,basename,ALL)
  391.             StrAdd(outline,' ',1)
  392.             a:=EstrLen(outline)
  393.             outline[l+4]:=0
  394.             outline[a-1]:=0
  395.             IF Write(outhandle,outline,a)<a THEN error(ER_OUT)
  396.  
  397.         ELSEIF (StrCmp(fdtmp+2,'BIAS',4))
  398.             IF (pos:=InStr(fdtmp,'=',6))=-1 THEN pos:=6
  399.  
  400.             newbias:=Val(pos+fdtmp,{a})
  401.  
  402. /*            WriteF('\n bias: \d newbias: \d\n',bias,newbias)    /* Debug-Info */*/
  403.  
  404.             IF (newbias < bias) OR (a=0) THEN error(ER_BIAS)
  405.             StrCopy(fdtmp,'Dum.',ALL)
  406.             fdtmp[3]:=16
  407.             WHILE newbias > bias
  408.                 outlong(fdtmp)
  409.                 ADDQ.L    #6,bias
  410.             ENDWHILE
  411.             IF newbias <> bias THEN error(ER_BIAS)
  412.         ELSEIF    (StrCmp(fdtmp+2,'END',3)) ; CLR.L    noeof
  413.         ELSEIF    (StrCmp(fdtmp+2,'PUBLIC',6)) ; NOP
  414.         ELSEIF    (StrCmp(fdtmp+2,'PRIVATE',7)) ; NOP
  415.         ELSE
  416.             error(ER_CMD)
  417.         ENDIF
  418.     ELSEIF (c="*")
  419.         NOP
  420.     ELSE
  421.         IF (l:=InStr(fdtmp,'(',0))=-1 THEN error(ER_NAME)
  422.         StrCopy(outline,fdline,l)
  423.  
  424.         StrCopy(tmpline,'LVO',ALL)
  425.         StrAdd(tmpline,fdtmp,l)
  426.  
  427.          tmpline[l+3]:=0                /* End-Marker */
  428.         tmpline[l+4]:=0                /* For Alingment */
  429.         MOVE.L    l,D0
  430.         ADDQ.W    #5,D0
  431.         AND.B    #$FE,D0                /* Needs even Name-Length */
  432.         MOVE.L    D0,a
  433.  
  434.         newbias:=0-bias
  435.         tmpword([a])
  436.         tmplong([newbias])
  437.         IF (Write(tmphandle,tmpline,a))<a THEN error(ER_TMP)
  438.  
  439.         IF    asmflag
  440.             StringF(tmpline,'_LVO\s\tEQU \d\n',outline,newbias)
  441.             a:=EstrLen(tmpline)
  442.             IF (Write(lvohandle,tmpline,a))<a THEN error(ER_LVO)
  443.         ENDIF
  444.  
  445.         MOVE.L    outline,A0
  446.         AND.B    #$DF,(A0)            /* First Char Ucase    */
  447.         OR.B    #$20,1(A0)            /* Second : Lcase    */
  448.  
  449.         a:=l+outline
  450.         IF (pos2:=InStr(fdtmp,')',l))=-1 THEN error(ER_NAME)
  451.         IF (pos2-l)>1                /* Data between the "()" */
  452.  
  453.             IF (pos:=InStr(fdtmp,'(',pos2))=-1 THEN error(ER_NAME)
  454.             ADDQ.L    #1,pos
  455.             IF (pos2:=InStr(fdtmp,')',pos))=-1 THEN error(ER_NAME)
  456.             pos :=pos    +fdtmp
  457.             pos2:=pos2    +fdtmp
  458.  
  459.             WHILE pos<pos2
  460.                 REPEAT
  461.                     c:=pos[]++
  462.                 UNTIL (c<>$20)            /* Ignore Space */
  463.  
  464.                 CLR.L    l
  465.  
  466. /* Small cleanup in v1.2 */
  467.                 IF c=$41                ;/* 'A'*/
  468.                     ADDQ.L    #8,l
  469.                 ELSEIF c<>$44            ;/* 'D'*/
  470.                     error(ER_NAME)
  471.                 ENDIF
  472.  
  473.                 c:=pos[]++
  474.                 IF (c<$30) OR (c>$37) THEN error(ER_NAME)
  475.                 l:=l+(c AND 7)
  476.                 MOVE.L    a,A0
  477.                 MOVE.L    l,D0
  478.                 MOVE.B    D0,(A0)+    /* Register-Number for Parameter */
  479.                 MOVE.L    A0,a
  480.  
  481.  
  482. /* Seperator "," OR "/" here */
  483.  
  484.                 c:=pos[]++
  485.                 IF (pos<pos2)
  486.                     IF (c<>$2c) AND (c<>$2f) THEN error(ER_NAME)    /* Format-Error*/
  487.                 ENDIF
  488.             ENDWHILE
  489.         ELSE
  490.             MOVE.L    a,A0
  491.             MOVE.B    #16,(A0)+    /* No Parameter */
  492.             MOVE.L    A0,a
  493.         ENDIF
  494.         a:=a-outline
  495.         IF    bias>=30                            /*    Resource-Handling added in 1.2 */
  496.             IF (Write(outhandle,outline,a))<a THEN error(ER_OUT)
  497.         ENDIF
  498.         ADDQ.L    #6,bias
  499.     ENDIF
  500.     IF    (noeof) THEN getline()
  501.   ENDWHILE
  502.  
  503.   tmpword([0])                    /* End-Code */
  504.   IF    asmflag
  505.     IF (Write(lvohandle,'\n\tENDC\n',7))<7 THEN error(ER_LVO)    /* Ende */
  506.   ENDIF
  507.   MOVE.L    outline,A0
  508.   MOVE.B    #255,(A0)            /* End-Code */
  509.   IF (Write(outhandle,outline,1))<=0 THEN error(ER_OUT)
  510.   WriteF('\n')
  511. ENDPROC
  512.  
  513. /* ############################# */
  514.  
  515. PROC error(ernum)
  516.   IF fdhandle    THEN Close(fdhandle)
  517.   IF lvohandle    THEN Close(lvohandle)
  518.   IF tmphandle    THEN Close(tmphandle)
  519.   IF outhandle    THEN Close(outhandle)
  520.   IF (rdargs)    THEN FreeArgs(rdargs)
  521.  
  522.   WriteF('\n\e[1m')
  523.  
  524.   tmpline[]:=0
  525.   IF (KickVersion(36)) AND (dosnum<>0) THEN Fault(dosnum,'\e[0m',tmpline,120)
  526.  
  527.   SELECT ernum
  528.     CASE ER_NONE;   WriteF('\e[0mAll Done.\n')
  529.     CASE ER_ARGS;   WriteF('Usage: fdtom fdname[.fd]')
  530.     CASE ER_FD;     WriteF('Could not read "\s" \s',fdname,tmpline)
  531.  
  532.     CASE ER_TMP;    WriteF('Could not write "\s" \s',tmpname,tmpline)
  533.     CASE ER_LVO;    WriteF('Could not write "\s" \s',lvoname,tmpline)
  534.     CASE ER_OUT;    WriteF('Could not write "\s" \s',outname,tmpline)
  535.  
  536.     CASE ER_MEM;    WriteF('Could not allocate memory')
  537.     CASE ER_BREAK;  WriteF('******* User Break ******')
  538.     CASE ER_FORM;   WriteF('.fd file format error')
  539.     CASE ER_CMD;    WriteF('Unknown Command')
  540.     CASE ER_NAME;    WriteF('Name-Error')
  541.     CASE ER_BIAS;    WriteF('BIAS-Fault.')
  542.     CASE ER_BASE;    WriteF('BASE-Fault.')
  543.   ENDSELECT
  544.  
  545.   WriteF('\e[0m\e[ p\n')
  546.   IF wbmessage<>0 THEN WriteF('CLI-Only.\nPress "Return" to Quit.')
  547.   IF (ernum>0) AND (line )
  548.     WriteF('"\s"\nPress "CTRL-C" to Stop Deletion.\n',fdline)
  549.     Delay(250)
  550.     IF    CtrlC()=0
  551.         DeleteFile(outname)                /* Return-Value not checked */
  552.         DeleteFile(lvoname)                /* dito. */
  553.         DeleteFile(tmpname)                /* dito. */
  554.     ENDIF
  555.   ENDIF
  556.   CleanUp(ernum)
  557. ENDPROC
  558.  
  559.